home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / bin / dpp.c next >
Encoding:
C/C++ Source or Header  |  1989-12-12  |  12.1 KB  |  647 lines
  1. /*
  2.     dpp.c
  3.  
  4.     defun preprocessor
  5. */
  6.  
  7. /*
  8.     Usage:
  9.         dpp file
  10.  
  11.     The file named file.d is preprocessed and the output will be
  12.     written to the file whose name is file.c.
  13.  
  14.     
  15.     ;changes: remove \n from beginning of main output so debuggers
  16.     can find the right foo.d source file name.--wfs
  17.     ;add \" to the line output for ansi C --wfs
  18.  
  19.     The function definition:
  20.  
  21.     @(defun name ({var}*
  22.               [&optional {var | (var [initform [svar]])}*]
  23.               [&rest]
  24.               [&key {var |
  25.                  ({var | (keyword var)} [initform [svar]])}*
  26.                 [&allow_other_keys]]
  27.               [&aux {var | (var [initform])}*])
  28.  
  29.         C-declaration
  30.  
  31.     @
  32.  
  33.         C-body
  34.  
  35.     @)
  36.  
  37.     &optional may be abbreviated as &o.
  38.     &rest may be abbreviated as &r.
  39.     &key may be abbreviated as &k.
  40.     &allow_other_keys may be abbreviated as &aok.
  41.     &aux may be abbreviated as &a.
  42.  
  43.     Each variable becomes a macro name
  44.     defined to be an expression of the form
  45.         vs_base[...].
  46.  
  47.     Each supplied-p parameter becomes a boolean C variable.
  48.  
  49.     Initforms are C expressions.
  50.     It an expression contain non-alphanumeric characters,
  51.     it should be surrounded by backquotes (`).
  52.  
  53.  
  54.     Function return:
  55.  
  56.         @(return {form}*)
  57.  
  58.     It becomes a C block.
  59.  
  60. */
  61.  
  62. #include <stdio.h>
  63.  
  64.  
  65. #ifdef UNIX
  66. #include <ctype.h>
  67. #define    isalphanum(c)    isalnum(c)
  68. #endif
  69.  
  70. #define    POOLSIZE    2048
  71. #define    MAXREQ        16
  72. #define    MAXOPT        16
  73. #define    MAXKEY        16
  74. #define    MAXAUX        16
  75. #define    MAXRES        16
  76.  
  77. #define    TRUE        1
  78. #define    FALSE        0
  79.  
  80. typedef int bool;
  81.  
  82. FILE *in, *out;
  83.  
  84. char filename[BUFSIZ];
  85. int line;
  86. int tab;
  87. int tab_save;
  88.  
  89. char pool[POOLSIZE];
  90. char *poolp;
  91.  
  92. char *function;
  93.  
  94. char *required[MAXREQ];
  95. int nreq;
  96.  
  97. struct optional {
  98.     char *o_var;
  99.     char *o_init;
  100.     char *o_svar;
  101. } optional[MAXOPT];
  102. int nopt;
  103.  
  104. bool rest_flag;
  105.  
  106. bool key_flag;
  107. struct keyword {
  108.     char *k_key;
  109.     char *k_var;
  110.     char *k_init;
  111.     char *k_svar;
  112. } keyword[MAXKEY];
  113. int nkey;
  114. bool allow_other_keys_flag;
  115.  
  116. struct aux {
  117.     char *a_var;
  118.     char *a_init;
  119. } aux[MAXAUX];
  120. int naux;
  121.  
  122. char *result[MAXRES];
  123. int nres;
  124.  
  125. error(s)
  126. char *s;
  127. {
  128.     printf("Error in line %d: %s.\n", line, s);
  129.     exit(0);
  130. }
  131.  
  132. readc()
  133. {
  134.     int c;
  135.  
  136.     c = getc(in);
  137.     if (feof(in)) {
  138.         if (function != NULL)
  139.             error("unexpected end of file");
  140.         exit(0);
  141.     }
  142.     if (c == '\n') {
  143.         line++;
  144.         tab = 0;
  145.     } else if (c == '\t')
  146.         tab++;
  147.     return(c);
  148. }
  149.  
  150. nextc()
  151. {
  152.     int c;
  153.  
  154.     while (isspace(c = readc()))
  155.         ;
  156.     return(c);
  157. }
  158.  
  159. unreadc(c)
  160. int c;
  161. {
  162.     if (c == '\n')
  163.         --line;
  164.     else if (c == '\t')
  165.         --tab;
  166.     ungetc(c, in);
  167. }
  168.  
  169. put_tabs(n)
  170. int n;
  171. {
  172.     int i;
  173.  
  174.     for (i = 0;  i < n;  i++)
  175.         putc('\t', out);
  176. }
  177.  
  178. pushc(c)
  179. int c;
  180. {
  181.     if (poolp >= &pool[POOLSIZE])
  182.         error("buffer bool overflow");
  183.     *poolp++ = c;
  184. }
  185.  
  186. char *
  187. read_token()
  188. {
  189.     int c;
  190.     char *p;
  191.  
  192.     p = poolp;
  193.     if ((c = nextc()) == '`') {
  194.         while ((c = readc()) != '`')
  195.             pushc(c);
  196.         pushc('\0');
  197.         return(p);
  198.     }
  199.     do
  200.         pushc(c);
  201.     while (isalphanum(c = readc()) || c == '_');
  202.     pushc('\0');
  203.     unreadc(c);
  204.     return(p);
  205. }
  206.  
  207. reset()
  208. {
  209.     int i;
  210.  
  211.     poolp = pool;
  212.     function = NULL;
  213.     nreq = 0;
  214.     for (i = 0;  i < MAXREQ;  i++)
  215.         required[i] = NULL;
  216.     nopt = 0;
  217.     for (i = 0;  i < MAXOPT;  i++)
  218.         optional[i].o_var
  219.         = optional[i].o_init
  220.         = optional[i].o_svar
  221.         = NULL;
  222.     rest_flag = FALSE;
  223.     key_flag = FALSE;
  224.     nkey = 0;
  225.     for (i = 0;  i < MAXKEY;  i++)
  226.         keyword[i].k_key
  227.         = keyword[i].k_var
  228.         = keyword[i].k_init
  229.         = keyword[i].k_svar
  230.         = NULL;
  231.     allow_other_keys_flag = FALSE;
  232.     naux = 0;
  233.     for (i = 0;  i < MAXAUX;  i++)
  234.         aux[i].a_var
  235.         = aux[i].a_init
  236.         = NULL;
  237. }
  238.  
  239. get_function()
  240. {
  241.     function = read_token();
  242. }
  243.  
  244. get_lambda_list()
  245. {
  246.     int c;
  247.     char *p;
  248.  
  249.     if ((c = nextc()) != '(')
  250.         error("( expected");
  251.     for (;;) {
  252.         if ((c = nextc()) == ')')
  253.             return;
  254.         if (c == '&') {
  255.             p = read_token();
  256.             goto OPTIONAL;
  257.         }
  258.         unreadc(c);
  259.         p = read_token();
  260.         if (nreq >= MAXREQ)
  261.             error("too many required variables");
  262.         required[nreq++] = p;
  263.     }
  264.  
  265. OPTIONAL:
  266.     if (strcmp(p, "optional") != 0 && strcmp(p, "o") != 0)
  267.         goto REST;
  268.     for (;;  nopt++) {
  269.         if ((c = nextc()) == ')')
  270.             return;
  271.         if (c == '&') {
  272.             p = read_token();
  273.             goto REST;
  274.         }
  275.         if (nopt >= MAXOPT)
  276.             error("too many optional argument");
  277.         if (c == '(') {
  278.             optional[nopt].o_var = read_token();
  279.             if ((c = nextc()) == ')')
  280.                 continue;
  281.             unreadc(c);
  282.             optional[nopt].o_init = read_token();
  283.             if ((c = nextc()) == ')')
  284.                 continue;
  285.             unreadc(c);
  286.             optional[nopt].o_svar = read_token();
  287.             if (nextc() != ')')
  288.                 error(") expected");
  289.         } else {
  290.             unreadc(c);
  291.             optional[nopt].o_var = read_token();
  292.         }
  293.     }
  294.  
  295. REST:
  296.     if (strcmp(p, "rest") != 0 && strcmp(p, "r") != 0)
  297.         goto KEYWORD;
  298.     rest_flag = TRUE;
  299.     if ((c = nextc()) == ')')
  300.         return;
  301.     if (c != '&')
  302.         error("& expected");
  303.     p = read_token();
  304.     goto KEYWORD;
  305.  
  306. KEYWORD:
  307.     if (strcmp(p, "key") != 0 && strcmp(p, "k") != 0)
  308.         goto AUX;
  309.     key_flag = TRUE;
  310.     for (;;  nkey++) {
  311.         if ((c = nextc()) == ')')
  312.             return;
  313.         if (c == '&') {
  314.             p = read_token();
  315.             if (strcmp(p, "allow_other_keys") == 0 ||
  316.                 strcmp(p, "aok") == 0) {
  317.                 allow_other_keys_flag = TRUE;
  318.                 if ((c = nextc()) == ')')
  319.                     return;
  320.                 if (c != '&')
  321.                     error("& expected");
  322.                 p = read_token();
  323.             }
  324.             goto AUX;
  325.         }
  326.         if (nkey >= MAXKEY)
  327.             error("too many optional argument");
  328.         if (c == '(') {
  329.             if ((c = nextc()) == '(') {
  330.                 p = read_token();
  331.                 if (p[0] != ':' || p[1] == '\0')
  332.                     error("keyword expected");
  333.                 keyword[nkey].k_key = p + 1;
  334.                 keyword[nkey].k_var = read_token();
  335.                 if (nextc() != ')')
  336.                     error(") expected");
  337.             } else {
  338.                 unreadc(c);
  339.                 keyword[nkey].k_key
  340.                 = keyword[nkey].k_var
  341.                 = read_token();
  342.             }
  343.             if ((c = nextc()) == ')')
  344.                 continue;
  345.             unreadc(c);
  346.             keyword[nkey].k_init = read_token();
  347.             if ((c = nextc()) == ')')
  348.                 continue;
  349.             unreadc(c);
  350.             keyword[nkey].k_svar = read_token();
  351.             if (nextc() != ')')
  352.                 error(") expected");
  353.         } else {
  354.             unreadc(c);
  355.             keyword[nkey].k_key
  356.             = keyword[nkey].k_var
  357.             = read_token();
  358.         }
  359.     }
  360.  
  361. AUX:
  362.     if (strcmp(p, "aux") != 0 && strcmp(p, "a") != 0)
  363.         error("illegal lambda-list keyword");
  364.     for (;;) {
  365.         if ((c = nextc()) == ')')
  366.             return;
  367.         if (c == '&')
  368.             error("illegal lambda-list keyword");
  369.         if (naux >= MAXAUX)
  370.             error("too many auxiliary variable");
  371.         if (c == '(') {
  372.             aux[naux].a_var = read_token();
  373.             if ((c = nextc()) == ')')
  374.                 continue;
  375.             unreadc(c);
  376.             aux[naux].a_init = read_token();
  377.             if (nextc() != ')')
  378.                 error(") expected");
  379.         } else {
  380.             unreadc(c);
  381.             aux[naux].a_var = read_token();
  382.         }
  383.         naux++;
  384.     }
  385. }
  386.  
  387. get_return()
  388. {
  389.     int c;
  390.  
  391.     nres = 0;
  392.     for (;;) {
  393.         if ((c = nextc()) == ')')
  394.             return;
  395.         unreadc(c);
  396.         result[nres++] = read_token();
  397.     }
  398. }
  399.  
  400. put_fhead()
  401. {
  402.     fprintf(out, "L%s()\n{", function);
  403. }
  404.  
  405. put_declaration()
  406. {
  407.     int i;
  408.  
  409.     fprintf(out, "\tint narg;\n");
  410.     fprintf(out, "\tregister object *DPPbase=vs_base;\n");
  411.     
  412.     for (i = 0;  i < nopt;  i++)
  413.         if (optional[i].o_svar != NULL)
  414.             fprintf(out, "\tbool %s;\n",
  415.                 optional[i].o_svar);
  416.     for (i = 0;  i < nreq;  i++)
  417.         fprintf(out, "#define\t%s\tDPPbase[%d]\n",
  418.             required[i], i);
  419.     for (i = 0;  i < nopt;  i++)
  420.         fprintf(out, "#define\t%s\tDPPbase[%d+%d]\n",
  421.             optional[i].o_var, nreq, i);
  422.     for (i = 0;  i < nkey;  i++)
  423.         fprintf(out, "#define\t%s\tDPPbase[%d+%d+%d]\n",
  424.             keyword[i].k_var, nreq, nopt, i);
  425.     for (i = 0;  i < nkey;  i++)
  426.         if (keyword[i].k_svar != NULL)
  427.             fprintf(out, "\tbool %s;\n", keyword[i].k_svar);
  428.     for (i = 0;  i < naux;  i++)
  429.         fprintf(out, "#define\t%s\tDPPbase[%d+%d+2*%d+%d]\n",
  430.             aux[i].a_var, nreq, nopt, nkey, i);
  431.     fprintf(out, "\n");
  432.     fprintf(out, "\tnarg = vs_top - vs_base;\n");
  433.     if (nopt == 0 && !rest_flag && !key_flag)
  434.         fprintf(out, "\tcheck_arg(%d);\n", nreq);
  435.     else {
  436.         fprintf(out, "\tif (narg < %d)\n", nreq);
  437.         fprintf(out, "\t\ttoo_few_arguments();\n");
  438.     }
  439.     for (i = 0;  i < nopt;  i++)
  440.         if (optional[i].o_svar != NULL) {
  441.             fprintf(out, "\tif (narg > %d + %d)\n",
  442.                 nreq, i);
  443.             fprintf(out, "\t\t%s = TRUE;\n",
  444.                 optional[i].o_svar);
  445.             fprintf(out, "\telse {\n");
  446.             fprintf(out, "\t\t%s = FALSE;\n",
  447.                 optional[i].o_svar);
  448.             fprintf(out, "\t\tvs_push(%s);\n",
  449.                 optional[i].o_init);
  450.             fprintf(out, "\t\tnarg++;\n");
  451.             fprintf(out, "\t}\n");
  452.         } else if (optional[i].o_init != NULL) {
  453.             fprintf(out, "\tif (narg <= %d + %d) {\n",
  454.                 nreq, i);
  455.             fprintf(out, "\t\tvs_push(%s);\n",
  456.                 optional[i].o_init);
  457.             fprintf(out, "\t\tnarg++;\n");
  458.             fprintf(out, "\t}\n");
  459.         } else {
  460.             fprintf(out, "\tif (narg <= %d + %d) {\n",
  461.                 nreq, i);
  462.             fprintf(out, "\t\tvs_push(Cnil);\n");
  463.             fprintf(out, "\t\tnarg++;\n");
  464.             fprintf(out, "\t}\n");
  465.         }
  466.     if (nopt > 0 && !key_flag && !rest_flag) {
  467.         fprintf(out, "\tif (narg > %d + %d)\n", nreq, nopt);
  468.         fprintf(out, "\t\ttoo_many_arguments();\n");
  469.     }
  470.     if (key_flag) {
  471.         fprintf(out, "\tparse_key(vs_base+%d+%d,FALSE, %s, %d,\n",
  472.             nreq, nopt,
  473.             allow_other_keys_flag ? "TRUE" : "FALSE", nkey);
  474.         if (nkey > 0) {
  475.             i = 0;
  476.             for (;;) {
  477.                 fprintf(out, "\t\tK%s", keyword[i].k_key);
  478.                 if (++i == nkey) {
  479.                     fprintf(out, ");\n");
  480.                     break;
  481.                 } else
  482.                     fprintf(out, ",\n");
  483.             }
  484.         } else
  485.             fprintf(out, "\t\tCnil);");
  486.         fprintf(out, "\tvs_top = vs_base + %d+%d+2*%d;\n",
  487.             nreq, nopt, nkey);
  488.         for (i = 0;  i < nkey;  i++) {
  489.             if (keyword[i].k_init == NULL)
  490.                 continue;
  491.             fprintf(out, "\tif (vs_base[%d+%d+%d+%d]==Cnil)\n",
  492.                 nreq, nopt, nkey, i);
  493.             fprintf(out, "\t\t%s = %s;\n",
  494.                 keyword[i].k_var, keyword[i].k_init);
  495.         }
  496.         for (i = 0;  i < nkey;  i++)
  497.             if (keyword[i].k_svar != NULL)
  498.                 fprintf(out,
  499.                 "\t%s = vs_base[%d+%d+%d+%d] != Cnil;\n",
  500.                 keyword[i].k_svar, nreq, nopt, nkey, i);
  501.     }
  502.     for (i = 0;  i < naux;  i++)
  503.                 if (aux[i].a_init != NULL)
  504.             fprintf(out, "\tvs_push(%s);\n", aux[i].a_init);
  505.         else
  506.             fprintf(out, "\tvs_push(Cnil);\n");
  507. }
  508.  
  509. put_ftail()
  510. {
  511.     int i;
  512.  
  513.     for (i = 0;  i < nreq;  i++)
  514.         fprintf(out, "#undef %s\n", required[i]);
  515.     for (i = 0;  i < nopt;  i++)
  516.         fprintf(out, "#undef %s\n", optional[i].o_var);
  517.     for (i = 0;  i < nkey;  i++)
  518.         fprintf(out, "#undef %s\n", keyword[i].k_var);
  519.     for (i = 0;  i < naux;  i++)
  520.         fprintf(out, "#undef %s\n", aux[i].a_var);
  521.     fprintf(out, "}");
  522. }
  523.  
  524. put_return()
  525. {
  526.     int i, t;
  527.  
  528.     t = tab_save + 1;
  529.     if (nres == 0) {
  530.         fprintf(out, "{\n");
  531.         put_tabs(t);
  532.         fprintf(out, "vs_top = vs_base;\n");
  533.         put_tabs(t);
  534.         fprintf(out, "vs_base[0] = Cnil;\n");
  535.         put_tabs(t);
  536.         fprintf(out, "return;\n");
  537.         put_tabs(tab_save);
  538.         fprintf(out, "}");
  539.     } else if (nres == 1) {
  540.         fprintf(out, "{\n");
  541.         put_tabs(t);
  542.         fprintf(out, "vs_base[0] = %s;\n", result[0]);
  543.         put_tabs(t);
  544.         fprintf(out, "vs_top = vs_base + 1;\n");
  545.         put_tabs(t);
  546.         fprintf(out, "return;\n");
  547.         put_tabs(tab_save);
  548.         fprintf(out, "}");
  549.     } else {
  550.         fprintf(out, "{\n");
  551.         for (i = 0;  i < nres;  i++) {
  552.             put_tabs(t);
  553.             fprintf(out, "object R%d;\n", i);
  554.         }
  555.         for (i = 0;  i < nres;  i++) {
  556.             put_tabs(t);
  557.             fprintf(out, "R%d = %s;\n", i, result[i]);
  558.         }
  559.         for (i = 0;  i < nres;  i++) {
  560.             put_tabs(t);
  561.             fprintf(out, "vs_base[%d] = R%d;\n", i, i);
  562.         }
  563.         put_tabs(t);
  564.         fprintf(out, "vs_top = vs_base + %d;\n", nres);
  565.         put_tabs(t);
  566.         fprintf(out, "return;\n");
  567.         put_tabs(tab_save);
  568.         fprintf(out, "}");
  569.     }
  570. }
  571.  
  572. main_loop()
  573. {
  574.     int c;
  575.     char *p;
  576.  
  577.     line = 1;
  578.     fprintf(out, "# line %d \"%s\"\n", line, filename);
  579. LOOP:
  580.     reset();
  581.     fprintf(out, "\n# line %d \"%s\"\n", line, filename);
  582.     while ((c = readc()) != '@')
  583.         putc(c, out);
  584.     if (readc() != '(')
  585.         error("@( expected");
  586.     p = read_token();
  587.     if (strcmp(p, "defun") == 0) {
  588.         get_function();
  589.         get_lambda_list();
  590.         put_fhead();
  591.         fprintf(out, "\n# line %d \"%s\"\n", line, filename);
  592.         while ((c = readc()) != '@')
  593.             putc(c, out);
  594.         put_declaration();
  595.  
  596.     BODY:
  597.         fprintf(out, "\n# line %d \"%s\"\n", line, filename);
  598.         while ((c = readc()) != '@')
  599.             putc(c, out);
  600.         if ((c = readc()) == ')') {
  601.             put_ftail();
  602.             goto LOOP;
  603.         } else if (c != '(')
  604.             error("@( expected");
  605.         p = read_token();
  606.         if (strcmp(p, "return") == 0) {
  607.             tab_save = tab;
  608.             get_return();
  609.             put_return();
  610.             goto BODY;
  611.         } else
  612.             error("illegal symbol");
  613.     } else
  614.         error("illegal symbol");
  615. }
  616.  
  617. main(argc, argv)
  618. int argc;
  619. char **argv;
  620. {
  621.     char *p, *q;
  622.  
  623.     if (argc != 2)
  624.         error("arg count");
  625.     for (p = argv[1], q = filename;  *p != '\0';  p++, q++)
  626.         if (q >= &filename[BUFSIZ-3])
  627.             error("too long file name");
  628.         else
  629.             *q = *p;
  630.     q[0] = '.';
  631.     q[1] = 'd';
  632.     q[2] = '\0';
  633.     in = fopen(filename, "r");
  634.     if (in == NULL)
  635.         error("can't open input file");
  636.     q[1] = 'c';
  637.     out = fopen(filename, "w");
  638.     if (out == NULL)
  639.         error("can't open output file");
  640.     q[1] = 'd';
  641.     printf("dpp: %s -> ", filename);
  642.     q[1] = 'c';
  643.     printf("%s\n", filename);
  644.     q[1] = 'd';
  645.     main_loop();
  646. }
  647.